home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / dev / obero / oberon_lib.lha / oberon-a / source1.lha / source / ProjectOberon / Reals.mod < prev    next >
Text File  |  1994-08-08  |  5KB  |  179 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: Reals.mod $
  4.   Description: Low-level floating point conversions
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.3 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/08 16:40:34 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. ***************************************************************************)
  18.  
  19. MODULE Reals;
  20.  
  21. (*
  22. ** $C= CaseChk       $I= IndexChk  $L+ LongAdr   $N= NilChk
  23. ** $P= PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  24. ** $V= OvflChk       $Z= ZeroVars
  25. *)
  26.  
  27. IMPORT SYS := SYSTEM;
  28.  
  29. (*------------------------------------*)
  30. PROCEDURE Expo* (x : REAL) : INTEGER;
  31. (*
  32.  * This procedure extracts the exponent part of a REAL value.  Quoting from
  33.  * the RKM:Libraries, 3rd Ed, p834:
  34.  *
  35.  * "The exponent is the power of two needed to correctly position the
  36.  *  mantissa to reflect the number's true arithmetic value.  It is held in
  37.  *  excess-64 notation, which means that the two's-complement values are
  38.  *  adjusted upward by 64, thus changing $40 (-64) through $3F (+63) to $00
  39.  *  through $7F..."
  40.  *
  41.  * The exponent occupies bits 0-6 of the 32 bits of the value.
  42.  *)
  43.  
  44. BEGIN (* Expo *)
  45.   RETURN SHORT (SYS.VAL (LONGINT, x) MOD 128)
  46. END Expo;
  47.  
  48. (*------------------------------------*)
  49. PROCEDURE ExpoL* (x : LONGREAL) : INTEGER;
  50.  
  51. BEGIN (* ExpoL *)
  52.   RETURN Expo (SHORT (x))
  53. END ExpoL;
  54.  
  55. (*------------------------------------*)
  56. PROCEDURE SetExpo* (e : INTEGER; VAR x : REAL);
  57. (*
  58.  * This procedure sets the exponent part of a REAL variable.  It clears bits
  59.  * 0-6 using SYS.AND() and ORs the exponent onto the cleared area.
  60.  *
  61.  * Broken down into simple expressions, the algorithm is:
  62.  *   i := SYS.VAL (LONGINT, x);
  63.  *   i := SYS.AND (i, 0FFFFFF80H);
  64.  *   i := SYS.LOR (i, e MOD 128);
  65.  *   x := SYS.VAL (REAL, i)
  66.  *)
  67.  
  68. BEGIN (* SetExpo *)
  69.   x :=
  70.     SYS.VAL
  71.       ( REAL,
  72.         SYS.LOR
  73.           ( SYS.AND ( SYS.VAL (LONGINT, x), 0FFFFFF80H ),
  74.             LONG (e) MOD 128 ) )
  75. END SetExpo;
  76.  
  77. (*------------------------------------*)
  78. PROCEDURE SetExpoL* (e : INTEGER; VAR x : LONGREAL);
  79.  
  80.   VAR y : REAL;
  81.  
  82. BEGIN (* SetExpoL *)
  83.   y := SHORT (x); SetExpo (e, y); x := LONG (y)
  84. END SetExpoL;
  85.  
  86. (*------------------------------------*)
  87. PROCEDURE Ten* (e : INTEGER) : REAL;
  88.  
  89.   VAR result : REAL; n : INTEGER;
  90.  
  91. BEGIN (* Ten *)
  92.   result := 1.0; n := ABS (e);
  93.   WHILE n > 0 DO result := result * 10.0; DEC (n) END;
  94.   IF e >= 0 THEN
  95.     RETURN result
  96.   ELSE
  97.     RETURN 1.0 / result
  98.   END;
  99. END Ten;
  100.  
  101. (*------------------------------------*)
  102. PROCEDURE TenL* (e : INTEGER) : LONGREAL;
  103.  
  104. BEGIN (* TenL *)
  105.   RETURN LONG (Ten (e))
  106. END TenL;
  107.  
  108. (*------------------------------------*)
  109. PROCEDURE Convert* (x : REAL; n : INTEGER; VAR d : ARRAY OF CHAR);
  110. (*
  111.  * Converts a REAL into a string.  d will contain the n most significant
  112.  * digits of x, in REVERSE order.
  113.  *)
  114.  
  115.   VAR i : LONGINT;
  116.  
  117. BEGIN (* Convert *)
  118.   i := 0;
  119.   REPEAT
  120.     d [i] := CHR (ENTIER (x) MOD 10 + 30H); x := x / 10; INC (i)
  121.   UNTIL i = n;
  122. END Convert;
  123.  
  124. (*------------------------------------*)
  125. PROCEDURE ConvertL* (x : LONGREAL; n : INTEGER; VAR d : ARRAY OF CHAR);
  126.  
  127. BEGIN (* ConvertL *)
  128.   Convert (SHORT (x), n, d)
  129. END ConvertL;
  130.  
  131. (*------------------------------------*)
  132. PROCEDURE ConvertH* (x : REAL; VAR d : ARRAY OF CHAR);
  133. (*
  134.  * Converts a REAL into a hexadecimal string.
  135.  *)
  136.  
  137.   VAR i, j, k : LONGINT;
  138.  
  139. BEGIN (* ConvertH *)
  140.   d [7] := 0X; (* This should cause an index trap if d is too small. *)
  141.   (* $I- Turn off index checking now, since we know there is enough room. *)
  142.   k := SYS.VAL (LONGINT, x);
  143.   i := 8;
  144.   REPEAT
  145.     DEC (i);
  146.     IF k # 0 THEN
  147.       j := k MOD 10H; k := k DIV 10H;
  148.       IF j < 10 THEN d [i] := CHR (j + 30H) ELSE d [i] := CHR (j + 37H) END
  149.     ELSE
  150.       d [i] := "0"
  151.     END;
  152.   UNTIL i = 0;
  153.   (* $I= Set index checking to default. *)
  154. END ConvertH;
  155.  
  156. (*------------------------------------*)
  157. PROCEDURE ConvertHL* (x : LONGREAL; VAR d : ARRAY OF CHAR);
  158.  
  159. BEGIN (* ConvertHL *)
  160.   ConvertH (SHORT (x), d)
  161. END ConvertHL;
  162.  
  163. END Reals.
  164.  
  165. (***************************************************************************
  166.  
  167.   $Log: Reals.mod $
  168.   Revision 1.3  1994/08/08  16:40:34  fjc
  169.   Release 1.4
  170.  
  171.   Revision 1.2  1994/05/12  20:45:18  fjc
  172.   - Prepared for release
  173.  
  174. # Revision 1.1  1994/01/15  21:39:12  fjc
  175. # Start of revision control
  176. #
  177. ***************************************************************************)
  178.  
  179.